MODULE DhryStone;

(*
 * Compilercode-Testprogramm.
 *																							 Version 1.2, 15. Mai 1990
 *
 * Portiert durch Dirk Steins von C-Source (Version 1.1) nach Modula-2,
 * Ueberarbeitung und Dokumentation von Thomas Tempelmann.
 *
 * Register-Variable werden nicht im einzelnen spezifiziert, da dies
 * bei Modula-2 nicht vorgesehen ist.
 *
 * Dafuer wird in 'Proc1' eine WITH-Anweisung verwendet, fuer die es in der
 * C-Version nur ein Macro gibt (C bietet kein WITH-Konstrukt). Da aber
 * alles darauf hinweist, dass im Original dieses Programms, das in ADA
 * geschrieben wurde, WITH verwendet wurde, wird es auch hier in der
 * Modula-Version getan, schon allein, weil es sinnvoll fuer den Test ist.
 *
 * Fuer den Test sollten alle globalen Optimierungen aktiviert sein
 * und Bereichs-, Ueberlauf-, Stack- und weitere Pruefungen deaktiviert
 * sein.
 *
 * Achtung: Um beim Megamax-System korrekte Ergebnisse zu erhalten,
 * muss die Control-C-Abfrage in der Shell abgeschaltet sein!
 *
 * Ergebnisse:
 *
 * Compiler 						Hardware												 Dhrystones/s
 *	 SPC 2.0						Atari ST 8MHz 									 493
 *	 Megamax 3.8				Atari ST 8MHz 									 522
 *	 FTL 1.18 					Atari ST 8MHz 									 656
 *	 H„nisch 3.105			Atari ST 8MHz 									 710
 *	 TDI 3.01 					Atari ST 8MHz 									 717
 *	 M2AMIGA 3.3				Amiga 2000 7.16MHz (2MB FastRAM) 847
 *	 FST 2.0						IBM AT 286 12MHz								 1060
 *	 Megamax 4.0				Atari ST 8MHz 									 1061
 *	 Rowley 1.34				Atari ST 8MHz 									 1500
 *	 LogiTech 3.4 DOS 	80386 24MHz/0ws 								 4755
 *	 Rowley 1.34				Sun-3/60	68020 20 MHz					 5500
 *	 Rowley 1.33				T800	20 MHz										 8500
 *	 Rowley 1.33				R3000  16 MHz 									 12500
 *	 ---------------------------------------------------------
 *	 Megamax 4.0			 Atari ST 32MHz 									 2941
 *
 *	 H„nisch 3.20a		 Atari ST 8MHz	(K+)							 893
 *	 H„nisch 3.20a		 Atari ST 8MHz	(RegVar,K+) 			 906
 *
 *	 H„nisch 3.20a		 Atari TT 32MHz  (K+) 						 2538
 *	 H„nisch 3.20a		 Atari TT 32MHz  (Reg-Var,K+) 		 2816
 *	 H„nisch 3.20a		 Atari TT 32MHz  (20er,K-)				 2531
 *	 H„nisch 3.20a		 Atari TT 32Mhz  (RegVar,20er,K-)  2828
 *
 *	 TopSpeed 1.17		 386SX		16MHz 									 3012
 *	 FTL							 386SX		16MHz 									 2336
 *
 *	 H„nisch 5.10 		 Atari TT 32Mhz  (RegVar) 				 5970
 *	 H„nisch 5.10 		 Atari TT 32Mhz  (RegVar,20er,K-)  6016
 *	 ---------------------------------------------------------
 *	 Ohne Compare-Aufruf:
 *	 Megamax 4.0			 Atari ST 32MHz 									 3210
 *
 *	 H„nisch 3.20a		 Atari TT 32Mhz  (RegVar,20er,K-)  3322
 *
 *)

FROM SYSTEM 		IMPORT ADR;
FROM Storage		IMPORT ALLOCATE;
FROM InOut			IMPORT WriteString, WriteLn, WriteCard, WriteInt, Read;
FROM Str				IMPORT Compare;

	(*$W+*)

(**** Compiler-/Library-abhaengige Importe ****)

		(* fuer time-Funktion, s.u. *)
		(*
		FROM Minix			IMPORT time;
		*)
		FROM SysVar 		IMPORT T200Hz;
		FROM SYSTEM 		IMPORT ADDRESS, CODE, TSIZE;

(**** Compiler-abhaengige Definitionen ****)

		TYPE	Integer 	 = SHORTINT;	(* moeglichst 16 Bit-Integer *)


(**** Compiler-/Library-abhaengige Funktionen ****)


(**** Beginn des unabhaengigen Programms *)


CONST Version = "1.2";

CONST LOOPS = 50000;	(* fuer ca. 10 - 20 Sekunden *)


TYPE Enumeration		= (Ident1, Ident2, Ident3, Ident4, Ident5);
TYPE OneToThirty		= [1..30];
TYPE OneToFifty 		= [1..50];
TYPE CapitalLetter	= CHAR;
TYPE String30 			= ARRAY [0..30] OF CHAR;
TYPE Array1Dim			= ARRAY [0..50] OF Integer;
TYPE Array2Dim			= ARRAY [0..50],[0..50] OF Integer;

TYPE RecordPtr			= POINTER TO RecordType;

		 RecordType 		= RECORD
												PtrComp 	: RecordPtr;
												Discr 		: Enumeration;
												EnumComp	: Enumeration;
												IntComp 	: OneToFifty;
												StringComp: String30;
											END;


(*
 * Package 1
 *)
VAR
	IntGlob 	: Integer;
	BoolGlob	: BOOLEAN;
	Char1Glob : CHAR;
	Char2Glob : CHAR;
	Array1Glob: Array1Dim;
	Array2Glob: Array2Dim;
	PtrGlb		: RecordPtr;
	PtrGlbNext: RecordPtr;


PROCEDURE Func1(CharPar1, CharPar2: CapitalLetter): Enumeration;
	VAR (*$Reg*) CharLoc1,
			(*$Reg*) CharLoc2 : CapitalLetter;
	BEGIN
		CharLoc1:= CharPar1;
		CharLoc2:= CharLoc1;
		IF (CharLoc2 # CharPar2) THEN
			RETURN Ident1
		ELSE
			RETURN Ident2
		END
	END Func1;


PROCEDURE Func2 ( VAR StrParI1, StrParI2: String30): BOOLEAN;
	VAR (*$Reg*) IntLoc: OneToThirty;
			(*$Reg*) CharLoc: CapitalLetter;
	BEGIN
		IntLoc:= 1;
		WHILE (IntLoc <= 1) DO
			IF (Func1 (StrParI1[IntLoc], StrParI2[IntLoc+1]) = Ident1) THEN
				CharLoc:= 'A';
				INC(IntLoc);
			END;
		END;
		IF (CharLoc >= 'W') & (CharLoc <= 'Z') THEN
			IntLoc:= 7;
		END;
		IF (CharLoc = 'X') THEN
			RETURN TRUE
		ELSE
			IF (Compare(StrParI1, StrParI2) > 0) THEN
				INC(IntLoc,7);
				RETURN TRUE
			ELSE
				RETURN FALSE
			END
		END;
	END Func2;

PROCEDURE Func3(EnumParIn: Enumeration): BOOLEAN;
	(*$Reg*) VAR	EnumLoc: Enumeration;
	BEGIN
		EnumLoc:= EnumParIn;
		IF (EnumLoc = Ident3) THEN
			RETURN TRUE
		END;
		RETURN FALSE
	END Func3;


PROCEDURE Proc7 ( IntParI1, IntParI2: OneToFifty; VAR IntParOut: OneToFifty);
	(*$Reg*) VAR IntLoc: OneToFifty;
	BEGIN
		IntLoc:= IntParI1 + 2;
		IntParOut:= IntParI2 + IntLoc;
	END Proc7;

PROCEDURE Proc3(VAR PtrParOut : RecordPtr);
	BEGIN
		IF (PtrGlb # NIL) THEN
			PtrParOut := PtrGlb^.PtrComp;
		ELSE
			IntGlob := 100;
		END;
		Proc7(10, IntGlob, PtrGlb^.IntComp);
	END Proc3;

PROCEDURE Proc6(EnumParIn : Enumeration; VAR EnumParOut: Enumeration);
	BEGIN
		EnumParOut := EnumParIn;
		IF (NOT Func3(EnumParIn) ) THEN
			EnumParOut := Ident4;
		END;
		CASE EnumParIn OF
			Ident1: EnumParOut := Ident1; |
			Ident2: IF (IntGlob > 100) THEN
								EnumParOut := Ident1
							ELSE
								EnumParOut := Ident4
							END |
			Ident3: EnumParOut := Ident2 |
			Ident4: |
			Ident5: EnumParOut := Ident3 |
		END;
	END Proc6;

PROCEDURE Proc1(PtrParIn : RecordPtr);
	BEGIN
		PtrParIn^.PtrComp^ := PtrGlb^;
		PtrParIn^.IntComp := 5;
		WITH PtrParIn^.PtrComp^ DO
			IntComp := PtrParIn^.IntComp;
			PtrComp := PtrParIn^.PtrComp;
			Proc3(PtrComp);
			IF (Discr = Ident1) THEN
				IntComp := 6;
				Proc6(PtrParIn^.EnumComp, EnumComp);
				PtrComp := PtrGlb^.PtrComp;
				Proc7(IntComp, 10, IntComp);
			ELSE
				PtrParIn := PtrParIn^.PtrComp;
			END;
		END;
	END Proc1;

PROCEDURE Proc2(VAR IntParIO : OneToFifty);
	VAR (*$Reg*) IntLoc  : OneToFifty;
			(*$Reg*) EnumLoc : Enumeration;
	BEGIN
		IntLoc := IntParIO + 10;
		LOOP
			IF (Char1Glob = 'A') THEN
				DEC(IntLoc);
				IntParIO := IntLoc - VAL (OneToFifty, IntGlob);
				EnumLoc  := Ident1;
			END;
			IF (EnumLoc = Ident1) THEN
				EXIT
			END;
		END;
	END Proc2;

PROCEDURE Proc4();
	VAR (*$Reg*) BoolLoc : BOOLEAN;
	BEGIN
		BoolLoc := Char1Glob = 'A';
		BoolLoc := NOT BoolGlob;
		Char2Glob := 'B';
	END Proc4;

PROCEDURE Proc5();
	BEGIN
		Char1Glob := 'A';
		BoolGlob := FALSE;
	END Proc5;

PROCEDURE Proc8 ( VAR Array1Par: Array1Dim; VAR Array2Par: Array2Dim;
									IntParI1, IntParI2: OneToFifty);
	VAR (*$Reg*) IntLoc: OneToFifty;
			(*$Reg*) IntIndex: OneToFifty;
	BEGIN
		IntLoc:= IntParI1 + 5;
		Array1Par[IntLoc]:= IntParI2;
		Array1Par[IntLoc+1]:= Array1Par[IntLoc];
		Array1Par[IntLoc+30]:= IntLoc;
		FOR IntIndex:= IntLoc TO IntLoc+1 DO
			Array2Par[IntLoc][IntIndex]:= IntLoc;
		END;
		INC(Array2Par[IntLoc][IntLoc-1]);
		Array2Par[IntLoc+20][IntLoc]:= Array1Par[IntLoc];
		IntGlob:= 5;
	END Proc8;

PROCEDURE Proc0();
	VAR
		IntLoc1 	 : OneToFifty;
		(*$Reg*) IntLoc2		: OneToFifty;
		IntLoc3 	 : OneToFifty;
		(*$Reg*) CharLoc		: CHAR;
		(*$Reg*) CharIndex	: CHAR;
		EnumLoc 	 : Enumeration;
		String1Loc : String30;
		String2Loc : String30;
		starttime  : LONGINT;
		benchtime  : LONGINT;
		nulltime	 : LONGINT;
		i 				 : [0..LOOPS];

	BEGIN
		starttime := T200Hz();
		FOR i := 0 TO LOOPS-1 DO END;
		nulltime := INT(T200Hz()) - starttime; (* Computes overhead of loop *)

		ALLOCATE (PtrGlbNext, TSIZE (RecordPtr));
		ALLOCATE (PtrGlb, TSIZE (RecordPtr));
		PtrGlb^.PtrComp := PtrGlbNext;
		PtrGlb^.Discr := Ident1;
		PtrGlb^.EnumComp := Ident3;
		PtrGlb^.IntComp := 40;
		PtrGlb^.StringComp := "DHRYSTONE PROGRAM, SOME STRING";
		String1Loc := "DHRYSTONE PROGRAM, 1'ST STRING"; 	(*GOOF*)
		Array2Glob[8][7] := 10;

		(*****************
		-- Start Timer --
		*****************)

		starttime := INT(T200Hz());

		FOR i := 0 TO LOOPS-1 DO
			Proc5();
			Proc4();
			IntLoc1 := 2;
			IntLoc2 := 3;
			String2Loc := "DHRYSTONE PROGRAM, 2'ND STRING";
			EnumLoc := Ident2;
			BoolGlob := NOT Func2(String1Loc, String2Loc);
			WHILE (IntLoc1 < IntLoc2)  DO
				IntLoc3 := 5 * IntLoc1 - IntLoc2;
				Proc7(IntLoc1, IntLoc2, IntLoc3);
				INC(IntLoc1);
			END;
			Proc8(Array1Glob, Array2Glob, IntLoc1, IntLoc3);
			Proc1(PtrGlb);
			FOR CharIndex := 'A' TO Char2Glob DO
				IF (EnumLoc = Func1(CharIndex, 'C')) THEN
					Proc6(Ident1, EnumLoc);
				END;
			END;
			IntLoc3 := IntLoc2 * IntLoc1;
			IntLoc2 := IntLoc3 DIV IntLoc1;
			IntLoc2 := 7 * (IntLoc3 - IntLoc2) - IntLoc1;
			Proc2(IntLoc1);
		END;


		(*****************
		-- Stop Timer --
		*****************)

		benchtime := INT(T200Hz()) - starttime - nulltime;
		WriteString("Modula-2 Dhrystone (");
		WriteString(Version);
		WriteString(") time for ");
		WriteCard(LOOPS,6);
		WriteString(" passes is ");
		WriteInt(benchtime DIV 200, 5);
		WriteLn;
		WriteString("This machine benchmarks at ");
		WriteInt(LOOPS*200 DIV benchtime,6);
		WriteString(" dhrystones/second");
		WriteLn;
	END Proc0;

VAR ch: CHAR;

BEGIN
	WriteString ("Running...");
	WriteLn;
	Proc0 ();
	Read (ch);
END DhryStone.
		
	
	